home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / kaleido.bas < prev    next >
BASIC Source File  |  1990-08-20  |  3KB  |  91 lines
  1.  '******************************************************************************
  2.  '* KALEIDO - Kaleioscope line drawing demo.                                   *
  3.  '*                                                                            *
  4.  '* Written for GRAFIX by:  Joseph A. Albrecht                                 *
  5.  '*                                                                            *
  6.  '* Press F1 to pause program                                                  *
  7.  '* Press F2 to clear the screen                                               *
  8.  '* Press F10 to toggle between 320 and 640 graphic modes                      *
  9.  '* Press ESC to exit program                                                  *
  10.  '* ****************************************************************************
  11.  '$INCLUDE: 'GRAFQBS.INC'
  12.  'The above line is for QuickBASIC.
  13.  
  14.  ''$INCLUDE "GRAFTBS.INC"
  15.  'The above line is for TURBO BASIC. Remove the  ''  to compile the program.
  16.  
  17.  ''$INCLUDE "GRAFPBS.INC"
  18.  'The above line is for PowerBASIC. Remove the  ''  to compile the program.
  19.  
  20.  DEF FNRND (Maximum) = INT(RND * Maximum) + 1
  21.  
  22.  Graphics = 320
  23.  MX = 160
  24.  MY = 100
  25.  M = 100
  26.  MaxDelta = 7
  27.  MaxColor = 15
  28.  CALL GetTandy11(Tandy11%)
  29.  CALL MediumGraphics
  30.  
  31. Again:
  32.  DO
  33.    RANDOMIZE TIMER
  34.    CALL ClearScreen
  35.    X1 = FNRND(M) + 1
  36.    X2 = FNRND(M) + 1
  37.    Y1 = FNRND(X1)
  38.    Y2 = FNRND(X2)
  39.    DO
  40.      LC = FNRND(MaxColor) 'Ensure good color separation
  41.      LC = FNRND(MaxColor)
  42.      CALL SetPlotColor(LC)
  43.      XV1 = FNRND(11) - 5
  44.      XV2 = FNRND(11) - 5
  45.      YV1 = FNRND(11) - 5
  46.      YV2 = FNRND(11) - 5
  47.      DO WHILE (FNRND(10) > 1)
  48.        XA = (X1 * 9) \ MaxDelta
  49.        XB = (X2 * 9) \ MaxDelta
  50.        YA = (Y1 * 9) \ MaxDelta
  51.        YB = (Y2 * 9) \ MaxDelta
  52.        CALL ExtLine(MX + XB, MY - Y2, MX + XA, MY - Y1)
  53.        CALL ExtLine(MX - YB, MY + X2, MX - YA, MY + X1)
  54.        CALL ExtLine(MX - XB, MY - Y2, MX - XA, MY - Y1)
  55.        CALL ExtLine(MX - YB, MY - X2, MX - YA, MY - X1)
  56.        CALL ExtLine(MX - XB, MY + Y2, MX - XA, MY + Y1)
  57.        CALL ExtLine(MX + YB, MY - X2, MX + YA, MY - X1)
  58.        CALL ExtLine(MX + XB, MY + Y2, MX + XA, MY + Y1)
  59.        CALL ExtLine(MX + YB, MY + X2, MX + YA, MY + X1)
  60.        X1 = ABS((X1 + XV1) MOD M)
  61.        Y1 = ABS((Y1 + YV1) MOD M)
  62.        X2 = ABS((X2 + XV2) MOD M)
  63.        Y2 = ABS((Y2 + YV2) MOD M)
  64.      LOOP
  65.      K$ = INKEY$
  66.      K$ = RIGHT$(K$, 1)
  67.      IF K$ = CHR$(27) THEN
  68.        CALL ExitGraphics
  69.        END
  70.      END IF
  71.      IF K$ = CHR$(59) THEN CALL WaitKey
  72.      IF K$ = CHR$(60) THEN GOTO Again
  73.      IF K$ = CHR$(68) AND Tandy11% = Tandy11.True% THEN
  74.        IF Graphics = 320 THEN
  75.      Graphics = 640
  76.      MX = 320
  77.      MaxDelta = 4
  78.      CALL HighGraphics
  79.      GOTO Again
  80.        ELSE
  81.      Graphics = 320
  82.      MX = 160
  83.      MaxDelta = 7
  84.      CALL MediumGraphics
  85.      GOTO Again
  86.        END IF
  87.      END IF
  88.    LOOP
  89.  LOOP
  90.  
  91.